(defpackage :parse
  (:use :cl)
  (:export #:num-op-num
           #:op-num
           #:num-op
           #:op
           #:num))

(in-package :parse)

(defmacro expect (test &body body)
  `(if ,test
       (progn ,@body)
     (error "Parse failure: ~a" ,test)))

(defun parse-number (stream)
  (let ((acc (make-array 1 :element-type 'character :adjustable t :fill-pointer 0)))
    ;; Read a possible -
    (when (char= #\- (peek-char nil stream))
      (vector-push-extend (read-char stream) acc))
    ;; Read the number
    (expect (digit-char-p (peek-char nil stream))
            (vector-push-extend (read-char stream) acc))
    (loop while (and (peek-char nil stream nil)
                     (digit-char-p (peek-char nil stream)))
          do (vector-push-extend (read-char stream) acc))
    (read-from-string acc)))

(defun parse-operator (stream)        
  ;; Read the operator
  (expect (find (peek-char nil stream) "+-*/")
          (read-from-string (string (read-char stream)))))

(defun parse-fraction (stream)
  (let ((acc (make-array 1 :element-type 'character :adjustable t :fill-pointer 0)))
    ;; Read a possible -
    (when (char= #\- (peek-char nil stream))
      (vector-push-extend (read-char stream) acc))
    ;; Read the number
    (expect (digit-char-p (peek-char nil stream))
            (vector-push-extend (read-char stream) acc))
    (loop while (digit-char-p (peek-char nil stream))
          do (vector-push-extend (read-char stream) acc))
    ;; read fraction
    (expect (char= #\/ (peek-char nil stream))
            (vector-push-extend (read-char stream) acc))
    ;; Read the number
    (expect (digit-char-p (peek-char nil stream))
            (vector-push-extend (read-char stream) acc))
    (loop while (and (peek-char nil stream nil)
                     (digit-char-p (peek-char nil stream)))
          do (vector-push-extend (read-char stream) acc))
    ;; CL simplifies the fraction. So don't accept it unless it's simplified.
    (let ((frac (read-from-string acc)))
      (when (string/= (prin1-to-string frac) acc)
        (error "unreduced fraction"))
      frac)))

;; (defmacro define-input-parser (name &rest fields)
;;   (with-gensyms (str parse-templ p1 stream)
;;     `(defun ,name (str)
;;        (macrolet ((,parse-templ ,(loop for f in fields collect (second f))
;;                      (let ((,stream (make-string-input-stream str)))
;;                        ;; read space
;;                        (loop while (find (peek-char nil ,stream) '(#\Space #\Tab)) do (read-char ,stream))
;;                        (let ,(loop for f in fields
;;                                    collect `(,(first f) (prog1
;;                                                             (,(second f) ,stream)
;;                                                           (loop while (find (peek-char nil ,stream) '(#\Space #\Tab)) do (read-char ,stream)))))
;;                          ;; read trailing space
;;                          (loop while (find (peek-char nil ,stream) '(#\Space #\Tab)) do (read-char ,stream))
;;                          (if (eq (peek-char nil ,stream nil ,stream) ,stream)
;;                              (list ,@(loop for f in fields collect (first f)))
;;                            (error "trailing garbage"))))))
;;          (or ,@(loop for 

(defun parse-seq (str &rest fns)
  "use each fn in fns to parse string. Eat whitespace before and
  after each fn. Return the result in a list or signal an
  error if it wasn't able to parse."
  (labels ((eat-space (stream)
             (loop while (find (peek-char nil stream) '(#\Space #\Tab)) do (read-char stream)))
           (maybe-eat-space (stream)
            (loop while (and (peek-char nil stream nil)
                             (find (peek-char nil stream) '(#\Space #\Tab))) do (read-char stream))))
    (let ((stream (make-string-input-stream str)))
      (prog1
          (loop for fn in fns
                collect (progn
                          (eat-space stream)
                          (funcall fn stream)))
        (maybe-eat-space stream)
        (unless (eq (peek-char nil stream nil stream) stream)
          (error "trailing garbage"))))))

(defun num (str)
  (or (ignore-errors (parse-seq str 'parse-number))
      (ignore-errors (parse-seq str 'parse-fraction))))

(defun op (str)
  (ignore-errors (parse-seq str 'parse-operator)))

(defun num-op (str)
  (or (ignore-errors (parse-seq str 'parse-number 'parse-operator))
      (ignore-errors (parse-seq str 'parse-fraction 'parse-operator))))
  
(defun op-num (str)
  (or (ignore-errors (parse-seq str 'parse-operator 'parse-number))
      (ignore-errors (parse-seq str 'parse-operator 'parse-fraction))))

(defun num-op-num (str)
  (macrolet ((line (fn1 fn2)
                   `(ignore-errors (parse-seq str ,fn1 'parse-operator ,fn2))))
    (or (line 'parse-number 'parse-number)
        (line 'parse-number 'parse-fraction)
        (line 'parse-fraction 'parse-number)
        (line 'parse-fraction 'parse-fraction))))
